  subroutine mopy2mo_abab_s(icore, itmp, noa, nob, nva, nvb, nmo, l)   
  implicit none 
  integer, intent(in) :: nmo, nva, noa, nvb, nob, l
  real*4, intent(in) :: icore(nmo, nmo, nmo)
  real*4, intent(out) :: itmp(*)

  integer i, j, k, a, b, c, d 
  integer idx   
  integer noa2, nob2, noab, nva2, nvb2, nvab
  integer nvoa, nvob, nvaob, nvboa
  integer nfirst, nread
  real*8, external :: dnrm2
  noa2  = noa*(noa-1)/2
  nob2  = nob*(nob-1)/2
  noab  = noa*nob
  nva2  = nva*(nva-1)/2
  nvb2  = nvb*(nvb-1)/2
  nvab  = nva*nvb
  nvoa  = nva*noa
  nvob  = nvb*nob
  nvaob = nva*nob
  nvboa = nvb*noa 
  !ABAB
    !IJKL_ABAB
    if(l<=nob) then  
      do k = 1, noa 
      do j = 1, nob 
      do i = 1, noa 
         !<Ij||Kl>=(IK|jk)
         idx = (k-1)*noab + (j-1)*noa + i
         itmp(idx) = icore(i,k,j) 
      enddo
      enddo
      enddo
      nfirst = (l-1)*noa + 1 
      nread = noa
      call putlstso_s(itmp, nfirst, nread, 1, 1, 'IJKLABS_')
    endif
    
    !ABIJ_ABAB
    if(l<=nob) then 
       j = l 
       do i = 1, noa 
       do b = 1, nvb
       do a = 1, nva 
          ! <Ab||Ij>=(AI|bj)
          idx = (i-1)*nvab + (b-1)*nva +a 
          itmp(idx) = icore(a+noa,i,b+nob) 
       enddo
       enddo
       enddo
       nfirst = (j-1)*noa + 1 
       nread = noa
       call putlstso_s(itmp, nfirst, nread, 1, 1, 'ABIJABS_')
    endif

    !IaBj_ABAB = BIaj
    if(l<=nob) then
       j = l
       do a = 1, nvb 
       do i = 1, noa
       do b = 1, nva
          ! <Ia||Bj>=(IB|aj)
          idx = (a-1)*nvoa + (i-1)*nva +b
          itmp(idx) = icore(i,b+noa,a+nob) 
       enddo
       enddo
       enddo
       nfirst =(j-1)*nvb+1 
       nread = nvb
       call putlstso_s(itmp, nfirst, nread, 1, 1, 'BIAJAABS')
    endif

    !iABj_BAAB = BiAj
    if(l<=nob) then
       j = l
       do a = 1, nva
       do i = 1, nob
       do b = 1, nva
          ! <iA||Bj>=-(AB|ij)
          idx = (a-1)*nvaob + (i-1)*nva +b
          itmp(idx) = -icore(a+noa,b+noa,i) 
       enddo
       enddo
       enddo
       nfirst =(j-1)*nva+1
       nread = nva
       call putlstso_s(itmp, nfirst, nread, 1, 1, 'BIAJABAS')
    endif

    !IabJ_ABBA = bIaJ  
    if(l>nob) then
       a = l-nob
       do j = 1, noa
         do i = 1, noa
         do b = 1, nvb
            ! <Ia||bJ>=-(IJ|ab)=-(IJ|ba)
            idx =  (i-1)*nvb +b
            itmp(idx) = -icore(i,j,b+nob) 
         enddo
         enddo
         nfirst = (j-1)*nvb+a
         call putlstso_s(itmp, nfirst, 1, 1, 1, 'BIAJBABS')
       enddo
    endif

    !ABCI_ABAB
    if(l<=nob) then  
    i=l 
    do c = 1, nva
    do b = 1, nvb
    do a = 1, nva
       !<Ab||Ci> = (AC|bi)
       idx = (c-1)*nvab + (b-1)*nva + a
       itmp(idx) = icore(a+noa,c+noa,b+nob) 
    enddo
    enddo
    enddo
    nfirst = (i-1)*nva + 1 
    nread = nva
    call putlstso_s(itmp, nfirst, nread, 1, 1, 'ABCIABS_')
    endif

    !ABCI_BABA
    if(l>nob) then
    c=l-nob
    do i = 1, noa
       do b = 1, nva
       do a = 1, nvb
          !<aB||cI> = (ac|BI)=(BI|ac)
          idx = (b-1)*nvb + a
          itmp(idx) = icore(b+noa,i,a+nob)
       enddo
       enddo
       nfirst = (i-1)*nvb + c 
       nread = 1
       call putlstso_s(itmp, nfirst, nread, 1, 1, 'ABCIBAS_')
    enddo
    endif

    !IJKA_ABAB
    if(l>nob) then
    a = l-nob 
    do k = 1, noa
    do j = 1, nob
    do i = 1, noa
       !<Ij||Ka> = (IK|ja)
       idx = (k-1)*noab + (j-1)*noa + i
       itmp(idx) = icore(i,k,j) 
    enddo
    enddo
    enddo
    nfirst = (a-1)*noa+1
    nread = noa
    call putlstso_s(itmp, nfirst, nread, 1, 1, 'IJKAABS_')
    endif

    !IJKA_BABA
    if(l<=nob) then
    k = l
    do a = 1, nva
       do j = 1, noa
       do i = 1, nob
          !<iJ||kA> = (JA|ik)
          idx = (j-1)*nob + i
          itmp(idx) = icore(j,a+noa,i)
       enddo
       enddo
       nfirst = (a-1)*nob+k
       nread = 1 
       call putlstso_s(itmp, nfirst, nread, 1, 1, 'IJKABAS_')
    enddo
    endif

    !ABCD_AAAA
    if(l>nob) then
    d=l-nob
    do c = 1, nva 
    do b = 1, nvb
    do a = 1, nva
       !<Ab||Cd> = (AC|bd)
       idx = (c-1)*nvab + (b-1)*nva + a
       itmp(idx) = icore(a+noa,c+noa,b+nob) 
    enddo
    enddo
    enddo
    nfirst = (d-1)*nva+1 
    nread = nva
    call putlstso_s(itmp, nfirst, nread, 1, 1, 'ABCDABS_')
    endif
  return
  end
    
  
